home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d3
/
db4less3.arc
/
EMPRATE.FRG
< prev
next >
Wrap
Text File
|
1990-06-16
|
7KB
|
336 lines
* Program............: D:\DBSYS\CLASSES\BT4W\EMPRATE.FRG
* Date...............: 11-17-88
* Versions...........: dBASE IV, Report 1
*
* Notes:
* ------
* Prior to running this procedure with the DO command
* it is necessary use LOCATE because the CONTINUE
* statement is in the main loop.
*
*-- Parameters
PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
** The first three parameters are of type Logical.
** The fourth parameter is a string. The fifth is extra.
PRIVATE _peject, _wrap
*-- Test for no records found
IF EOF() .OR. .NOT. FOUND()
RETURN
ENDIF
*-- turn word wrap mode off
_wrap=.F.
IF _plength < 10
SET DEVICE TO SCREEN
DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
ACTIVATE WINDOW gw_report
@ 0,1 SAY "Increase the page length for this report."
@ 2,1 SAY "Press any key ..."
x=INKEY(0)
DEACTIVATE WINDOW gw_report
RELEASE WINDOW gw_report
RETURN
ENDIF
_plineno=0 && set lines to zero
*-- NOEJECT parameter
IF gl_noeject
IF _peject="BEFORE"
_peject="NONE"
ENDIF
IF _peject="BOTH"
_peject="AFTER"
ENDIF
ENDIF
*-- Set-up environment
ON ESCAPE DO prnabort
IF SET("TALK")="ON"
SET TALK OFF
gc_talk="ON"
ELSE
gc_talk="OFF"
ENDIF
gc_space=SET("SPACE")
SET SPACE OFF
gc_time=TIME() && system time for predefined field
gd_date=DATE() && system date " " " "
gl_fandl=.F. && first and last page flag
gl_prntflg=.T. && Continue printing flag
gl_widow=.T. && flag for checking widow bands
gn_length=LEN(gc_heading) && store length of the HEADING
gn_level=2 && current band being processed
gn_page=_pageno && grab current page number
*-- Set up procedure for page break
IF _pspacing > 1
gn_atline=_plength - (_pspacing + 1)
ELSE
gn_atline=_plength - 2
ENDIF
ON PAGE AT LINE gn_atline EJECT PAGE
*-- Print Report
PRINTJOB
*-- Initialize group break vars.
r_mvar4=DEPT
*-- Initialize summary variables.
DECLARE GAVGRATE[3]
STORE 0 TO GAVGRATE[1]
STORE 0 TO GAVGRATE[2],GAVGRATE[3]
DECLARE SAVGRATE[3]
STORE 0 TO SAVGRATE[1]
STORE 0 TO SAVGRATE[2],SAVGRATE[3]
IF gl_plain
ON PAGE AT LINE gn_atline DO Pgplain
ELSE
ON PAGE AT LINE gn_atline DO Pgfoot
ENDIF
DO Pghead
gl_fandl=.T. && first physical page started
DO Grphead
*-- File Loop
DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
DO CASE
CASE .NOT. (DEPT = r_mvar4)
gn_level=4
OTHERWISE
gn_level=0
ENDCASE
*-- test whether an expression didn't match
IF gn_level <> 0
DO Grpfoot WITH 100-gn_level
DO Grpinit
ENDIF
*-- Repeat group intros
IF gn_level <> 0
DO Grphead
ENDIF
DO Upd_Vars
*-- Detail lines
IF .NOT. gl_summary
DO Detail
ENDIF
CONTINUE
ENDDO
IF gl_prntflg
gn_level=3
DO Grpfoot WITH 97
DO Rsumm
IF _plineno <= gn_atline
EJECT PAGE
ENDIF
ELSE
gn_level=3
DO Rsumm
DO Reset
RETURN
ENDIF
ON PAGE
ENDPRINTJOB
DO Reset
RETURN
* EOP: D:\DBSYS\CLASSES\BT4W\EMPRATE.FRG
*-- Update summary fields and/or calculated fields in the detail band.
PROCEDURE Upd_Vars
*-- Summary calculation - Average
GAVGRATE[1]=GAVGRATE[1]+1 && count
GAVGRATE[2]=GAVGRATE[2]+RATE && sum
GAVGRATE[3]=GAVGRATE[2]/GAVGRATE[1] && average
*-- Summary calculation - Average
SAVGRATE[1]=SAVGRATE[1]+1 && count
SAVGRATE[2]=SAVGRATE[2]+RATE && sum
SAVGRATE[3]=SAVGRATE[2]/SAVGRATE[1] && average
RETURN
* EOP: Upd_Vars
*-- Set flag to get out of DO WHILE loop when escape is pressed.
PROCEDURE prnabort
gl_prntflg=.F.
RETURN
* EOP: prnabort
*-- Reset group break variables. Reinit summary
*-- fields with reset set to a particular group band.
PROCEDURE Grpinit
IF gn_level <= 4
STORE 0 TO GAVGRATE[1]
STORE 0 TO GAVGRATE[2],GAVGRATE[3]
ENDIF
IF gn_level <= 4
r_mvar4=DEPT
ENDIF
RETURN
* EOP: Grpinit
*-- Process Group Intro bands during group breaks
PROCEDURE Grphead
IF EOF()
RETURN
ENDIF
gl_widow=.T. && enable widow checking
IF gn_level <= 4
DO Head4
ENDIF
gn_level=0
RETURN
* EOP: Grphead.PRG
*-- Process Group Summary bands during group breaks
PROCEDURE Grpfoot
PARAMETER ln_level
IF ln_level >= 96
DO Foot96
ENDIF
RETURN
* EOP: Grpfoot.PRG
PROCEDURE Pghead
IF .NOT. gl_plain
?? "Page No." AT 0,
?? _pageno PICTURE "999" AT 9
ENDIF
?
?? "Report Date:" AT 0,
?? IIF(gl_plain,'',gd_date) AT 13
?
?
*-- Print HEADING parameter ie. REPORT FORM <name> HEADING <expC>
IF .NOT. gl_plain .AND. gn_length > 0
?? gc_heading FUNCTION "I;V"+LTRIM(STR(_rmargin-_lmargin))
?
ENDIF
?? "EMPLOYEE PAY RATE REPORT" AT 25
?
?
?? ;
"▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";
+ "▒▒▒▒▒▒▒▒▒";
AT 0
?
?
RETURN
* EOP: Pghead
PROCEDURE Head4
IF gn_level=1
RETURN
ENDIF
IF 7 < _plength
IF (gl_widow .AND. _plineno+7 > gn_atline) ;
.OR. (gl_widow .AND. _plineno+6 > gn_atline)
EJECT PAGE
ENDIF
ENDIF
?
DEFINE BOX FROM 5 TO 31 HEIGHT 3 SINGLE
?
?? "Department:" AT 8,
?? DEPT FUNCTION "T" AT 22
?
?
?
?? "ID" AT 15,
?? "NAME" AT 22,
?? "RATE" AT 71
?
?
RETURN
PROCEDURE Detail
?? EMPID FUNCTION "T" AT 13,
?? FNAME FUNCTION "T" AT 22,
?? " " ,
?? LNAME FUNCTION "T" ,
?? RATE PICTURE "999.99" AT 70
?
RETURN
* EOP: Detail
PROCEDURE Foot96
?
DEFINE BOX FROM 44 TO 77 HEIGHT 3 SINGLE
?
?? "Department Average" AT 47,
?? GAVGRATE[3] PICTURE "9999999.99" AT 66
?
?
?
RETURN
PROCEDURE Rsumm
?
DEFINE BOX FROM 46 TO 77 HEIGHT 3 DOUBLE
?
?? "Company Average" AT 49,
?? SAVGRATE[3] PICTURE "9999999.99" AT 66
?
?
gl_fandl=.F. && last page finished
?
RETURN
* EOP: Rsumm
PROCEDURE Pgfoot
PRIVATE _box
gl_widow=.F. && disable widow checking
?
IF .NOT. gl_plain
ENDIF
EJECT PAGE
*-- is the page number greater than the ending page
IF _pageno > _pepage
GOTO BOTTOM
SKIP
gn_level=0
ENDIF
IF .NOT. gl_plain .AND. gl_fandl
DO Pghead
ENDIF
IF gn_level = 0 .AND. gl_fandl
gn_level=1
DO Grphead
ENDIF
gl_widow=.T. && enable widow checking
RETURN
* EOP: Pgfoot
*-- Process page break when PLAIN option is used.
PROCEDURE Pgplain
PRIVATE _box
EJECT PAGE
IF gn_level = 0 .AND. gl_fandl
gn_level=1
DO Grphead
ENDIF
RETURN
* EOP: Pgplain
*-- Reset dBASE environment prior to calling report
PROCEDURE Reset
SET SPACE &gc_space.
SET TALK &gc_talk.
ON ESCAPE
ON PAGE
RETURN
* EOP: Reset